home *** CD-ROM | disk | FTP | other *** search
/ CGI How-To / CGI HOW-TO.iso / chap6 / 6_7 / fork_pl / formdata.pl < prev    next >
Encoding:
Perl Script  |  1996-06-15  |  3.6 KB  |  197 lines
  1. #!/usr/bin/perl
  2.  
  3. # Subroutine for decoding form data
  4.  
  5. sub decodeData
  6. {
  7.     local(*queryString) = @_ if @_;
  8.     
  9.     #convert pluses to spaces
  10.     
  11.     $queryString =~ s/\+/ /g;
  12.  
  13.     # Convert the hex codes
  14.     #
  15.     # First find them with s/%(..)//ge,
  16.     # then turn the found hexcode into a decimal number,
  17.     # then pack the decimal number into character form,
  18.     # then do normal substitution.
  19.      
  20.     $queryString =~ s/%(..)/pack("c",hex($1))/ge; 
  21.     
  22.     # Return 1 for success
  23.         
  24.     return 1;
  25. }
  26.  
  27. # Subroutine for interpreting form data
  28.  
  29. sub parseData
  30. {
  31.     local(*queryString,*formData) = @_ if @_;
  32.     
  33.     local($key,$value,$curString,@tmpArray,$aName);
  34.     
  35.     # Split the string into key-value pairs, using the '&' character
  36.     
  37.     @tmpArray = split(/&/,$queryString);
  38.     
  39.     # Loop over each pair found
  40.     
  41.     foreach $curString (@tmpArray)
  42.     {
  43.         # Split the key and value, using the '=' character
  44.         
  45.         ($key,$value) = split(/=/,$curString);
  46.         
  47.         # Decode the key and value
  48.         
  49.         &decodeData(*key);
  50.         &decodeData(*value);
  51.         
  52.         # Add the keys and values to the dictionary
  53.         #
  54.         # We will store multple values under a new name,
  55.         # as a string, using the format, value1\376value2...
  56.         # Where \376 is a character unlikely to appear in the
  57.         # values.
  58.         
  59.         if($formData{$key}) # See if this is a multiple value
  60.         {
  61.             $aName = "A_".$key; # Make a new key
  62.             
  63.             if($formData{$aName}) #Check if the array already exists
  64.             {
  65.                 $formData{$aName} .= "\376";
  66.                 $formData{$aName} .= $value;
  67.                 
  68.                 # Also put the newest value in the dictionary
  69.                 # at the real key.
  70.                 
  71.                 $formData{$key} = $value;
  72.                 
  73.             }
  74.             else #If not, create it and add the current value to the array
  75.             {
  76.                 # Add the 1st value for the key to the string
  77.                 $formData{$aName} = $formData{$key};
  78.                 
  79.                 # Add the one that we just found
  80.                 
  81.                 $formData{$aName} .= "\376";
  82.                 $formData{$aName} .= $value;
  83.                 
  84.                 # Also put the newest value in the dictionary
  85.                 # at the real key.
  86.                 
  87.                 $formData{$key} = $value;
  88.             }
  89.         }
  90.         else # Just add it
  91.         {
  92.             $formData{$key} = $value;
  93.         }
  94.     }
  95.  
  96.     return 1;
  97. }
  98.  
  99. # Subroutine for reading post data
  100.  
  101. sub readPostData
  102. {
  103.     local(*queryString) = @_ if @_;
  104.  
  105.     local($contentLength);
  106.     
  107.     # Read the environment variable CONTENT_LENGTH
  108.     
  109.     $contentLength = $ENV{"CONTENT_LENGTH"};
  110.     
  111.     # Make sure that there is data to read
  112.     
  113.     if($contentLength)
  114.     {
  115.         # Read contentLength characters from STDIN into queryString
  116.         
  117.         read(STDIN,$queryString,$contentLength);
  118.     }
  119.  
  120.     # Return 1 for success
  121.     
  122.     return 1;
  123. }
  124.  
  125. sub readGetData
  126. {
  127.     local(*queryString) = @_ if @_;
  128.  
  129.     # Read the environment variable QUERY_STRING
  130.  
  131.     $queryString = $ENV{"QUERY_STRING"};
  132.     
  133.     return 1;
  134. }
  135.  
  136. sub readData
  137. {
  138.     local(*queryString) = @_ if @_;
  139.     
  140.     # Read the envorinmental variable REQUEST_METHOD
  141.     
  142.     $requestType = $ENV{"REQUEST_METHOD"};
  143.     
  144.     # If the request is GET use readGetData
  145.     # otherwise, if the request is POST use readPostData
  146.     
  147.     if($requestType eq "GET")
  148.     {
  149.         &readGetData(*queryString);
  150.     }
  151.     elsif($requestType eq "POST")
  152.     {
  153.         &readPostData(*queryString);
  154.     }
  155.  
  156. }
  157.  
  158. # Print the header required for all CGI scripts that output dynamic text data
  159.  
  160. print "Content-type: text/plain\n\n";
  161.  
  162. print "The form data is:\n\n";
  163.  
  164. # Make sure that this is a post request
  165.  
  166. %dataDict = ();
  167.  
  168. # Call readData, to determine the request type and read the data.
  169. # Notice that we use the variable name, not its value as an arguement
  170.  
  171. &readData(*data);
  172. &parseData(*data,*dataDict);
  173.  
  174. while(($key,$value)=each(%dataDict))
  175. {
  176.     if($key =~ /^A_/)
  177.     {
  178.         print "Found a key with multiple values:\n";
  179.         
  180.         @mValues = split(/\376/,$value);
  181.         
  182.         $realKey = $key;
  183.         $realKey =~ s/^A_//;
  184.         
  185.         foreach $mValue (@mValues)
  186.         {
  187.             print "\t",$realKey," = ",$mValue,"\n";
  188.         
  189.         }
  190.     }
  191.     else
  192.     {
  193.         print $key," = ",$value,"\n";
  194.     }
  195. }
  196.  
  197.